home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / GRAPHICS.SWG / 0047_Bresenham's Line.pas < prev    next >
Pascal/Delphi Source File  |  1994-01-27  |  3KB  |  138 lines

  1. {
  2. >> I was wondering if anyone could show me the equations (and perhaps a
  3. >> demo in standard pascal) of the following shapes. What I need to know is
  4. >> where to plot the point.
  5. >> Circle. (I've tried using the equation taught to me at school, but it
  6. >> Line  (What I would like would be to be able to plot a line by giving it
  7.  
  8. There seems yet again to be enough interest/need so I'll post this stuff just
  9. ONCE more.... somebody put this in SWAG or something.... PLEASE!!!
  10.  
  11.  [Okay Sean, here you go!  -Kerry]
  12.  
  13. You need a plot(x,y) procedure and a global color variable to use these as
  14. posted.
  15. }
  16.  
  17. {bresenham's line}
  18. procedure line(x, y, x2, y2 : integer);
  19. var
  20.   d, dx, dy,
  21.   ai, bi,
  22.   xi, yi : integer;
  23. begin
  24.   if (x < x2) then
  25.   begin
  26.     xi := 1;
  27.     dx := x2 - x;
  28.   end
  29.   else
  30.   begin
  31.     xi := - 1;
  32.     dx := x - x2;
  33.   end;
  34.  
  35.   if (y < y2) then
  36.   begin
  37.     yi := 1;
  38.     dy := y2 - y;
  39.   end
  40.   else
  41.   begin
  42.     yi := - 1;
  43.     dy := y - y2;
  44.   end;
  45.  
  46.   plot(x, y);
  47.  
  48.   if dx > dy then
  49.   begin
  50.     ai := (dy - dx) * 2;
  51.     bi := dy * 2;
  52.     d  := bi - dx;
  53.     repeat
  54.       if (d >= 0) then
  55.       begin
  56.         inc(y, yi);
  57.         inc(d, ai);
  58.       end
  59.       else
  60.         inc(d, bi);
  61.  
  62.       inc(x, xi);
  63.       plot(x, y);
  64.     until (x = x2);
  65.   end
  66.   else
  67.   begin
  68.     ai := (dx - dy) * 2;
  69.     bi := dx * 2;
  70.     d  := bi - dy;
  71.     repeat
  72.       if (d >= 0) then
  73.       begin
  74.         inc(x, xi);
  75.         inc(d, ai);
  76.       end
  77.       else
  78.         inc(d, bi);
  79.  
  80.       inc(y, yi);
  81.       plot(x, y);
  82.     until (y = y2);
  83.   end;
  84. end;
  85.  
  86.  
  87. {filled ellipse}
  88. procedure disk(xc,  yc,  a,  b : integer);
  89. var
  90.   x, y      : integer;
  91.   aa, aa2,
  92.   bb, bb2,
  93.   d, dx, dy : longint;
  94. begin
  95.   x   := 0;
  96.   y   := b;
  97.   aa  := longint(a) * a;
  98.   aa2 := 2 * aa;
  99.   bb  := longint(b) * b;
  100.   bb2 := 2 * bb;
  101.   d   := bb - aa * b + aa div 4;
  102.   dx  := 0;
  103.   dy  := aa2 * b;
  104.   vLin(xc, yc - y, yc + y);
  105.  
  106.   while (dx < dy) do
  107.   begin
  108.     if (d > 0) then
  109.     begin
  110.       dec(y);
  111.       dec(dy, aa2);
  112.       dec(d, dy);
  113.     end;
  114.     inc(x);
  115.     inc(dx, bb2);
  116.     inc(d, bb + dx);
  117.     vLin(xc - x, yc - y, yc + y);
  118.     vLin(xc + x, yc - y, yc + y);
  119.   end;
  120.  
  121.   inc(d, (3 * (aa - bb) div 2 - (dx + dy)) div 2);
  122.   while (y >= 0) do
  123.   begin
  124.     if (d < 0) then
  125.     begin
  126.       inc(x);
  127.       inc(dx, bb2);
  128.       inc(d, bb + dx);
  129.       vLin(xc - x, yc - y, yc + y);
  130.       vLin(xc + x, yc - y, yc + y);
  131.     end;
  132.     dec(y);
  133.     dec(dy, aa2);
  134.     inc(d, aa - dy);
  135.   end;
  136. end;
  137.  
  138.